home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / BBS-Archive / Dev / GNU-SMALLTALK.lha / Bag.st < prev    next >
Text File  |  1992-02-15  |  4KB  |  175 lines
  1. "======================================================================
  2. |
  3. |   Bag Method Definitions
  4. |
  5.  ======================================================================"
  6.  
  7.  
  8. "======================================================================
  9. |
  10. | Copyright (C) 1990, 1991, 1992 Free Software Foundation, Inc.
  11. | Written by Steve Byrne.
  12. |
  13. | This file is part of GNU Smalltalk.
  14. |
  15. | GNU Smalltalk is free software; you can redistribute it and/or modify it
  16. | under the terms of the GNU General Public License as published by the Free
  17. | Software Foundation; either version 1, or (at your option) any later version.
  18. | 
  19. | GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
  20. | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  21. | FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
  22. | details.
  23. | 
  24. | You should have received a copy of the GNU General Public License along with
  25. | GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
  26. | Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  
  27. |
  28.  ======================================================================"
  29.  
  30.  
  31. "
  32. |     Change Log
  33. | ============================================================================
  34. | Author       Date       Change 
  35. | sbb         28 Jul 91      #= now checks args better.
  36. |
  37. | sbb         16 Mar 91      Class creation now separate statement.
  38. |
  39. | sbb         21 Sep 90      Removed printOn: method; the one from Collection does
  40. |              the right thing.
  41. |
  42. | sbyrne     25 Apr 89      created.
  43. |
  44. "
  45.  
  46. Collection subclass: #Bag
  47.        instanceVariableNames: 'contents'
  48.        classVariableNames: ''
  49.        poolDictionaries: ''
  50.        category: nil
  51. !
  52.  
  53. Bag comment:
  54. 'My instances are unordered collections of objects.  You can think
  55. of me as a set with a memory; that is, if the same object is added to me
  56. twice, then I will report that that element has been stored twice.'!
  57.  
  58.  
  59. !Bag class methodsFor: 'basic'!
  60.  
  61. new
  62.     ^super new initContents
  63. !!
  64.  
  65.  
  66.  
  67. !Bag methodsFor: 'Adding to a collection'!
  68.  
  69. add: newObject withOccurrences: anInteger
  70.     contents at: newObject
  71.          put: (self occurrencesOf: newObject) + anInteger.
  72.     ^newObject
  73. !
  74.  
  75. add: newObject
  76.     self add: newObject withOccurrences: 1.
  77.     ^newObject 
  78. !
  79.  
  80. at: index
  81.     self error: 'at: is not allowed for a Bag'
  82. !
  83.  
  84. at: index put: value
  85.     self error: 'at:put: is not allowed for a Bag'
  86. !!
  87.  
  88.  
  89.  
  90. !Bag methodsFor: 'Removing from a collection'!
  91.  
  92. remove: oldObject ifAbsent: anExceptionBlock
  93.     | count |
  94.     "Remove oldObject from the collection and return it.  Since we're using
  95.     a dictionary, we need decrement the value until it's zero, in which case
  96.     we can then remove the object from the dictionary"
  97.     count _ self occurrencesOf: oldObject.
  98.     count = 0 ifTrue: [ ^anExceptionBlock value ].
  99.     count = 1 ifTrue: [ contents removeKey: oldObject ]
  100.               ifFalse: [ contents at: oldObject
  101.                                 put: count - 1 ].
  102.     ^oldObject
  103. !!
  104.  
  105.  
  106.  
  107. !Bag methodsFor: 'testing collections'!
  108.  
  109. occurrencesOf: anObject
  110.     ^contents at: anObject ifAbsent: [ ^0 ]
  111. !
  112.  
  113. size
  114.     | count |
  115.     count _ 0.
  116.     contents do: [ :element | count _ count + element ].
  117.     ^count
  118. !
  119.  
  120. hash
  121.     ^contents hash
  122. !
  123.  
  124. = aBag
  125.     self class == aBag class
  126.     ifFalse: [ ^false ].
  127.     ^contents = aBag contents
  128. !!
  129.  
  130.  
  131.  
  132. !Bag methodsFor: 'enumerating the elements of a collection'!
  133.  
  134. do: aBlock
  135.     "Perform the block for all members in the collection.  For Bags, we need
  136.     to go through the contents dictionary, and perform the block for as many
  137.     occurrences of the objects as there are."
  138.     contents associationsDo:
  139.       [ :assoc |  assoc value timesRepeat: [ aBlock value: assoc key ] ]
  140. !!
  141.  
  142.  
  143.  
  144. !Bag methodsFor: 'storing'!
  145.  
  146. storeOn: aStream
  147.     | noElements |
  148.     aStream nextPut: $(;
  149.     nextPutAll: self classNameString;
  150.     nextPutAll: ' new'.
  151.     noElements _ true.
  152.     contents associationsDo:
  153.       [ :assoc | aStream nextPutAll: ' add: ';
  154.              store: assoc key;
  155.              nextPutAll: ' withOccurrences: ';
  156.              store: assoc value;
  157.              nextPut: $;.
  158.          noElements _ false ].
  159.     noElements ifFalse: [ aStream nextPutAll: '; yourself' ].
  160.     aStream nextPut: $)
  161. !!
  162.  
  163.  
  164.  
  165. !Bag methodsFor: 'private'!
  166.  
  167. initContents
  168.     contents _ Dictionary new
  169. !
  170.  
  171. contents
  172.     ^contents
  173. !!
  174.  
  175.